home *** CD-ROM | disk | FTP | other *** search
/ Aminet 52 / Aminet 52 (2002)(GTI - Schatztruhe)[!][Dec 2002].iso / Aminet / misc / emu / Apex-src.lha / XDUP.XPL < prev    next >
Text File  |  2001-09-30  |  3KB  |  141 lines
  1. \XDUP.XPL    FEB-17-89
  2. \Disk duplicator via Xmodem.
  3.  
  4. \REVISION HISTORY:
  5. \FEB-17-89, Fixed bug where sending computer hangs, added comments.
  6.  
  7. code    RESERVE=3,    CHIN=7,        CHOUT=8,    CRLF=9,
  8.     INTIN=10,    INTOUT=11,    TEXT=12,    OPENI=13,
  9.     OPENO=14,    CLOSE=15,    FREE=18,    FWRITE=30,
  10.     FREAD=31;
  11.  
  12. def    TV=0, KB=0;    \Device numbers
  13. int    UNIT,        \Unit involved in transfer
  14.     SIZE0,        \Size of BUFFER in blocks
  15.     BLOCKS,        \Total number of blocks to transfer
  16.     RECEIVING;    \Flag: This is the receiving computer
  17. addr    BUFFER;        \Array: buffer space
  18.  
  19.  
  20.  
  21. func    VERIFY;        \Return 'TRUE' if "Y" (or "y") is typed in
  22. begin
  23. TEXT(TV, " - ARE YOU SURE (N/Y)? ");
  24. OPENI(KB);
  25. return (CHIN(KB)!$20) = ^y;
  26. end;    \VERIFY
  27.  
  28.  
  29.  
  30. proc    XGET(BUFFER, SIZE);    \Receive buffer from Xmodem device
  31. addr    BUFFER;
  32. int    SIZE;        \Size of BUFFER in blocks
  33. int    I;
  34. begin
  35. for I:= 0, SIZE *256 -1 do
  36.     BUFFER(I):= CHIN(5);
  37. end;    \XGET
  38.  
  39.  
  40.  
  41. proc    XSEND(BUFFER, SIZE);    \Send buffer to Xmodem device
  42. addr    BUFFER;
  43. int    SIZE;        \Size of BUFFER in blocks
  44. int    I;
  45. begin
  46. for I:= 0, SIZE *256 -1 do
  47.     CHOUT(5, BUFFER(I));
  48. end;    \XSEND
  49.  
  50.  
  51.  
  52. proc    SHOWTITLE(UNIT);    \Output the title of the specified unit
  53. int    UNIT;
  54. int    I, CH;
  55. addr    BUFFER, TITLE;
  56. begin
  57. BUFFER:= RESERVE(256);
  58. TITLE:= BUFFER +88;        \Offset within block to title
  59. FREAD(UNIT, 12, BUFFER, 1);    \Read directory block containing title
  60. for I:= 0, 79 do
  61.     begin
  62.     CH:= TITLE(I);
  63.     if CH>=$20 & CH<$80 then CHOUT(TV, CH)
  64.     else I:= 80;
  65.     end;
  66. end;    \SHOWTITLE
  67.  
  68.  
  69.  
  70. proc    DUPDSK;        \Duplicate a disk using xmodem
  71. \Inputs: SIZE0, BLOCKS, UNIT, RECEIVING
  72. int    BLK,        \Starting block of current transfer
  73.     SIZE;        \Size of current transfer (in blocks)
  74. begin
  75. SIZE:= SIZE0;
  76. BLK:= 0;
  77. if RECEIVING then OPENI(5) else OPENO(5);
  78. TEXT(TV, "DUPING...
  79. ");
  80.  
  81. loop    begin
  82.     if BLOCKS-BLK < SIZE then    \Shrink SIZE if less than a buffer full
  83.         SIZE:= BLOCKS -BLK;
  84.     if SIZE = 0 then quit;        \Quit if none to transfer
  85.  
  86.     if RECEIVING then
  87.         [XGET(BUFFER, SIZE);
  88.         FWRITE(UNIT, BLK, BUFFER, SIZE)]
  89.     else    [FREAD(UNIT, BLK, BUFFER, SIZE);
  90.         XSEND(BUFFER, SIZE)];
  91.  
  92.     BLK:= BLK + SIZE;
  93.     end;
  94.  
  95. if RECEIVING then
  96.     begin
  97.     if CHIN(5) then;        \Read and discard the EOF
  98.     OPENI(5);            \Send ACK so sender can finish
  99.     end
  100. else    CLOSE(5);            \Send last buffer (and EOF)
  101. end;    \DUPDSK
  102.  
  103.  
  104.  
  105. begin    \MAIN
  106. SIZE0:= FREE /256;
  107. SIZE0:= SIZE0 -1;        \Leave a little space to work with (for safety)
  108. BUFFER:= RESERVE(SIZE0 *256);
  109.  
  110. TEXT(TV, "-- XMODEM DISK DUPLICATOR, V1.1 --
  111. BUFFER: ");   INTOUT(TV, SIZE0);   CRLF(TV);
  112.  
  113. TEXT(TV, "IS THIS THE RECEIVING COMPUTER (N/Y)?    ");
  114. OPENI(KB);
  115. RECEIVING:= (CHIN(KB) ! $20) = ^y;
  116.  
  117. if RECEIVING then
  118.     TEXT(TV, "DESTINATION UNIT NUMBER (0-7)?        ")
  119. else    TEXT(TV, "SOURCE UNIT NUMBER (0-7)?        ");
  120. UNIT:= INTIN(KB);
  121.  
  122. TEXT(TV, "HOW MANY BLOCKS? ");
  123. BLOCKS:= INTIN(KB);
  124.  
  125. loop    begin
  126.     if RECEIVING then
  127.         repeat    TEXT(TV, "ABOUT TO OVERWRITE UNIT ");
  128.             INTOUT(TV, UNIT);   CRLF(TV);
  129.             SHOWTITLE(UNIT);   CRLF(TV);
  130.         until VERIFY;
  131.  
  132.     DUPDSK;
  133.     TEXT(TV, "DUP ANOTHER DISK (N/Y)? ");
  134.     OPENI(KB);
  135.     if (CHIN(KB) ! $20) # ^y then quit;
  136.     CRLF(TV);
  137.     end;
  138. if RECEIVING then OPENI(5);        \Send ACK to tell sender we're all done
  139. end;    \MAIN
  140. ) ! $20) # ^y then quit;
  141.     CR